home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / mg.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-10-20  |  25.8 KB  |  1,431 lines  |  [TEXT/MPS ]
  1. /*    mg.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "Sam sat on the ground and put his head in his hands.  'I wish I had never
  12.  * come here, and I don't want to see no more magic,' he said, and fell silent."
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. /* Omit -- it causes too much grief on mixed systems.
  19. #ifdef I_UNISTD
  20. # include <unistd.h>
  21. #endif
  22. */
  23.  
  24. /*
  25.  * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
  26.  */
  27.  
  28. struct magic_state {
  29.     SV* mgs_sv;
  30.     U32 mgs_flags;
  31. };
  32. typedef struct magic_state MGS;
  33.  
  34. static void restore_magic _((void *p));
  35.  
  36. static MGS *
  37. save_magic(sv)
  38. SV* sv;
  39. {
  40.     MGS* mgs;
  41.  
  42.     assert(SvMAGICAL(sv));
  43.  
  44.     mgs = (MGS*)safemalloc(sizeof(MGS));
  45.     mgs->mgs_sv = sv;
  46.     mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
  47.     SAVEDESTRUCTOR(restore_magic, mgs);
  48.  
  49.     SvMAGICAL_off(sv);
  50.     SvREADONLY_off(sv);
  51.     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  52.  
  53.     return mgs;
  54. }
  55.  
  56. static void
  57. restore_magic(p)
  58. void* p;
  59. {
  60.     MGS *mgs = (MGS*)p;
  61.     SV* sv = mgs->mgs_sv;
  62.  
  63.     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
  64.     {
  65.     if (mgs->mgs_flags)
  66.         SvFLAGS(sv) |= mgs->mgs_flags;
  67.     else
  68.         mg_magical(sv);
  69.     if (SvGMAGICAL(sv))
  70.         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  71.     }
  72.  
  73.     safefree((void *)mgs);
  74. }
  75.  
  76.  
  77. void
  78. mg_magical(sv)
  79. SV* sv;
  80. {
  81.     MAGIC* mg;
  82.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  83.     MGVTBL* vtbl = mg->mg_virtual;
  84.     if (vtbl) {
  85.         if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
  86.         SvGMAGICAL_on(sv);
  87.         if (vtbl->svt_set)
  88.         SvSMAGICAL_on(sv);
  89.         if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
  90.         SvRMAGICAL_on(sv);
  91.     }
  92.     }
  93. }
  94.  
  95. int
  96. mg_get(sv)
  97. SV* sv;
  98. {
  99.     MGS* mgs;
  100.     MAGIC* mg;
  101.     MAGIC** mgp;
  102.  
  103.     ENTER;
  104.     mgs = save_magic(sv);
  105.  
  106.     mgp = &SvMAGIC(sv);
  107.     while ((mg = *mgp) != 0) {
  108.     MGVTBL* vtbl = mg->mg_virtual;
  109.     if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
  110.         (*vtbl->svt_get)(sv, mg);
  111.         /* Ignore this magic if it's been deleted */
  112.         if (*mgp == mg && (mg->mg_flags & MGf_GSKIP))
  113.         mgs->mgs_flags = 0;
  114.     }
  115.     /* Advance to next magic (complicated by possible deletion) */
  116.     if (*mgp == mg)
  117.         mgp = &mg->mg_moremagic;
  118.     }
  119.  
  120.     LEAVE;
  121.     return 0;
  122. }
  123.  
  124. int
  125. mg_set(sv)
  126. SV* sv;
  127. {
  128.     MGS* mgs;
  129.     MAGIC* mg;
  130.     MAGIC* nextmg;
  131.  
  132.     ENTER;
  133.     mgs = save_magic(sv);
  134.  
  135.     for (mg = SvMAGIC(sv); mg; mg = nextmg) {
  136.     MGVTBL* vtbl = mg->mg_virtual;
  137.     nextmg = mg->mg_moremagic;    /* it may delete itself */
  138.     if (mg->mg_flags & MGf_GSKIP) {
  139.         mg->mg_flags &= ~MGf_GSKIP;    /* setting requires another read */
  140.         mgs->mgs_flags = 0;
  141.     }
  142.     if (vtbl && vtbl->svt_set)
  143.         (*vtbl->svt_set)(sv, mg);
  144.     }
  145.  
  146.     LEAVE;
  147.     return 0;
  148. }
  149.  
  150. U32
  151. mg_len(sv)
  152. SV* sv;
  153. {
  154.     MAGIC* mg;
  155.     char *junk;
  156.     STRLEN len;
  157.  
  158.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  159.     MGVTBL* vtbl = mg->mg_virtual;
  160.     if (vtbl && vtbl->svt_len) {
  161.         ENTER;
  162.         save_magic(sv);
  163.         /* omit MGf_GSKIP -- not changed here */
  164.         len = (*vtbl->svt_len)(sv, mg);
  165.         LEAVE;
  166.         return len;
  167.     }
  168.     }
  169.  
  170.     junk = SvPV(sv, len);
  171.     return len;
  172. }
  173.  
  174. int
  175. mg_clear(sv)
  176. SV* sv;
  177. {
  178.     MAGIC* mg;
  179.  
  180.     ENTER;
  181.     save_magic(sv);
  182.  
  183.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  184.     MGVTBL* vtbl = mg->mg_virtual;
  185.     /* omit GSKIP -- never set here */
  186.     
  187.     if (vtbl && vtbl->svt_clear)
  188.         (*vtbl->svt_clear)(sv, mg);
  189.     }
  190.  
  191.     LEAVE;
  192.     return 0;
  193. }
  194.  
  195. MAGIC*
  196. mg_find(sv, type)
  197. SV* sv;
  198. int type;
  199. {
  200.     MAGIC* mg;
  201.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  202.     if (mg->mg_type == type)
  203.         return mg;
  204.     }
  205.     return 0;
  206. }
  207.  
  208. int
  209. mg_copy(sv, nsv, key, klen)
  210. SV* sv;
  211. SV* nsv;
  212. char *key;
  213. STRLEN klen;
  214. {
  215.     int count = 0;
  216.     MAGIC* mg;
  217.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  218.     if (isUPPER(mg->mg_type)) {
  219.         sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
  220.         count++;
  221.     }
  222.     }
  223.     return count;
  224. }
  225.  
  226. int
  227. mg_free(sv)
  228. SV* sv;
  229. {
  230.     MAGIC* mg;
  231.     MAGIC* moremagic;
  232.     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
  233.     MGVTBL* vtbl = mg->mg_virtual;
  234.     moremagic = mg->mg_moremagic;
  235.     if (vtbl && vtbl->svt_free)
  236.         (*vtbl->svt_free)(sv, mg);
  237.     if (mg->mg_ptr && mg->mg_type != 'g')
  238.         Safefree(mg->mg_ptr);
  239.     if (mg->mg_flags & MGf_REFCOUNTED)
  240.         SvREFCNT_dec(mg->mg_obj);
  241.     Safefree(mg);
  242.     }
  243.     SvMAGIC(sv) = 0;
  244.     return 0;
  245. }
  246.  
  247. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  248. #include <signal.h>
  249. #endif
  250.  
  251. U32
  252. magic_len(sv, mg)
  253. SV *sv;
  254. MAGIC *mg;
  255. {
  256.     register I32 paren;
  257.     register char *s;
  258.     register I32 i;
  259.     char *t;
  260.  
  261.     switch (*mg->mg_ptr) {
  262.     case '1': case '2': case '3': case '4':
  263.     case '5': case '6': case '7': case '8': case '9': case '&':
  264.     if (curpm) {
  265.         paren = atoi(mg->mg_ptr);
  266.       getparen:
  267.         if (curpm->op_pmregexp &&
  268.           paren <= curpm->op_pmregexp->nparens &&
  269.           (s = curpm->op_pmregexp->startp[paren]) &&
  270.           (t = curpm->op_pmregexp->endp[paren]) ) {
  271.         i = t - s;
  272.         if (i >= 0)
  273.             return i;
  274.         }
  275.     }
  276.     return 0;
  277.     break;
  278.     case '+':
  279.     if (curpm) {
  280.         paren = curpm->op_pmregexp->lastparen;
  281.         if (!paren)
  282.         return 0;
  283.         goto getparen;
  284.     }
  285.     return 0;
  286.     break;
  287.     case '`':
  288.     if (curpm) {
  289.         if (curpm->op_pmregexp &&
  290.           (s = curpm->op_pmregexp->subbeg) ) {
  291.         i = curpm->op_pmregexp->startp[0] - s;
  292.         if (i >= 0)
  293.             return i;
  294.         }
  295.     }
  296.     return 0;
  297.     case '\'':
  298.     if (curpm) {
  299.         if (curpm->op_pmregexp &&
  300.           (s = curpm->op_pmregexp->endp[0]) ) {
  301.         return (STRLEN) (curpm->op_pmregexp->subend - s);
  302.         }
  303.     }
  304.     return 0;
  305.     case ',':
  306.     return (STRLEN)ofslen;
  307.     case '\\':
  308.     return (STRLEN)orslen;
  309.     }
  310.     magic_get(sv,mg);
  311.     if (!SvPOK(sv) && SvNIOK(sv))
  312.     sv_2pv(sv, &na);
  313.     if (SvPOK(sv))
  314.     return SvCUR(sv);
  315.     return 0;
  316. }
  317.  
  318. int
  319. magic_get(sv, mg)
  320. SV *sv;
  321. MAGIC *mg;
  322. {
  323.     register I32 paren;
  324.     register char *s;
  325.     register I32 i;
  326.     char *t;
  327.  
  328.     switch (*mg->mg_ptr) {
  329.     case '\001':        /* ^A */
  330.     sv_setsv(sv, bodytarget);
  331.     break;
  332.     case '\004':        /* ^D */
  333.     sv_setiv(sv,(I32)(debug & 32767));
  334.     break;
  335.     case '\005':  /* ^E */
  336. #ifdef macintosh
  337.     {
  338.         char msg[256];
  339.         
  340.         sv_setnv(sv,(double)gLastMacOSErr);
  341.         sv_setpv(sv, gLastMacOSErr ? GetSysErrText(gLastMacOSErr, msg) : "");    
  342.     }
  343. #else
  344. #ifdef VMS
  345.     {
  346. #        include <descrip.h>
  347. #        include <starlet.h>
  348.         char msg[255];
  349.         $DESCRIPTOR(msgdsc,msg);
  350.         sv_setnv(sv,(double)vaxc$errno);
  351.         if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
  352.         sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
  353.         else
  354.         sv_setpv(sv,"");
  355.     }
  356. #else
  357.     sv_setnv(sv,(double)errno);
  358.     sv_setpv(sv, errno ? Strerror(errno) : "");
  359. #endif
  360. #endif
  361.     SvNOK_on(sv);    /* what a wonderful hack! */
  362.     break;
  363.     case '\006':        /* ^F */
  364.     sv_setiv(sv,(I32)maxsysfd);
  365.     break;
  366.     case '\010':        /* ^H */
  367.     sv_setiv(sv,(I32)hints);
  368.     break;
  369.     case '\t':            /* ^I */
  370.     if (inplace)
  371.         sv_setpv(sv, inplace);
  372.     else
  373.         sv_setsv(sv,&sv_undef);
  374.     break;
  375.     case '\017':        /* ^O */
  376.     sv_setpv(sv,osname);
  377.     break;
  378.     case '\020':        /* ^P */
  379.     sv_setiv(sv,(I32)perldb);
  380.     break;
  381.     case '\024':        /* ^T */
  382. #ifdef BIG_TIME
  383.      sv_setnv(sv,basetime);
  384. #else
  385.     sv_setiv(sv,(I32)basetime);
  386. #endif
  387.     break;
  388.     case '\027':        /* ^W */
  389.     sv_setiv(sv,(I32)dowarn);
  390.     break;
  391.     case '1': case '2': case '3': case '4':
  392.     case '5': case '6': case '7': case '8': case '9': case '&':
  393.     if (curpm) {
  394.         paren = atoi(GvENAME(mg->mg_obj));
  395.       getparen:
  396.         if (curpm->op_pmregexp &&
  397.           paren <= curpm->op_pmregexp->nparens &&
  398.           (s = curpm->op_pmregexp->startp[paren]) &&
  399.           (t = curpm->op_pmregexp->endp[paren]) ) {
  400.         i = t - s;
  401.         if (i >= 0) {
  402.             MAGIC *tmg;
  403.             sv_setpvn(sv,s,i);
  404.             if (tainting && (tmg = mg_find(sv,'t')))
  405.             tmg->mg_len = 0;    /* guarantee $1 untainted */
  406.             break;
  407.         }
  408.         }
  409.     }
  410.     sv_setsv(sv,&sv_undef);
  411.     break;
  412.     case '+':
  413.     if (curpm) {
  414.         paren = curpm->op_pmregexp->lastparen;
  415.         if (paren)
  416.         goto getparen;
  417.     }
  418.     sv_setsv(sv,&sv_undef);
  419.     break;
  420.     case '`':
  421.     if (curpm) {
  422.         if (curpm->op_pmregexp &&
  423.           (s = curpm->op_pmregexp->subbeg) ) {
  424.         i = curpm->op_pmregexp->startp[0] - s;
  425.         if (i >= 0) {
  426.             sv_setpvn(sv,s,i);
  427.             break;
  428.         }
  429.         }
  430.     }
  431.     sv_setsv(sv,&sv_undef);
  432.     break;
  433.     case '\'':
  434.     if (curpm) {
  435.         if (curpm->op_pmregexp &&
  436.           (s = curpm->op_pmregexp->endp[0]) ) {
  437.         sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
  438.         break;
  439.         }
  440.     }
  441.     sv_setsv(sv,&sv_undef);
  442.     break;
  443.     case '.':
  444. #ifndef lint
  445.     if (GvIO(last_in_gv)) {
  446.         sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
  447.     }
  448. #endif
  449.     break;
  450.     case '?':
  451.     sv_setiv(sv,(I32)statusvalue);
  452.     break;
  453.     case '^':
  454.     s = IoTOP_NAME(GvIOp(defoutgv));
  455.     if (s)
  456.         sv_setpv(sv,s);
  457.     else {
  458.         sv_setpv(sv,GvENAME(defoutgv));
  459.         sv_catpv(sv,"_TOP");
  460.     }
  461.     break;
  462.     case '~':
  463.     s = IoFMT_NAME(GvIOp(defoutgv));
  464.     if (!s)
  465.         s = GvENAME(defoutgv);
  466.     sv_setpv(sv,s);
  467.     break;
  468. #ifndef lint
  469.     case '=':
  470.     sv_setiv(sv,(I32)IoPAGE_LEN(GvIOp(defoutgv)));
  471.     break;
  472.     case '-':
  473.     sv_setiv(sv,(I32)IoLINES_LEFT(GvIOp(defoutgv)));
  474.     break;
  475.     case '%':
  476.     sv_setiv(sv,(I32)IoPAGE(GvIOp(defoutgv)));
  477.     break;
  478. #endif
  479.     case ':':
  480.     break;
  481.     case '/':
  482.     break;
  483.     case '[':
  484.     sv_setiv(sv,(I32)curcop->cop_arybase);
  485.     break;
  486.     case '|':
  487.     sv_setiv(sv, (IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
  488.     break;
  489.     case ',':
  490.     sv_setpvn(sv,ofs,ofslen);
  491.     break;
  492.     case '\\':
  493.     sv_setpvn(sv,ors,orslen);
  494.     break;
  495.     case '#':
  496.     sv_setpv(sv,ofmt);
  497.     break;
  498.     case '!':
  499. #ifdef VMS
  500.     sv_setnv(sv,(double)((errno == EVMSERR) ? vaxc$errno : errno));
  501. #else
  502.     sv_setnv(sv,(double)errno);
  503. #endif
  504.     sv_setpv(sv, errno ? Strerror(errno) : "");
  505.     SvNOK_on(sv);    /* what a wonderful hack! */
  506.     break;
  507.     case '<':
  508.     sv_setiv(sv,(I32)uid);
  509.     break;
  510.     case '>':
  511.     sv_setiv(sv,(I32)euid);
  512.     break;
  513.     case '(':
  514.     s = buf;
  515.     (void)sprintf(s,"%d",(int)gid);
  516.     goto add_groups;
  517.     case ')':
  518.     s = buf;
  519.     (void)sprintf(s,"%d",(int)egid);
  520.       add_groups:
  521.     while (*s) s++;
  522. #ifdef HAS_GETGROUPS
  523. #ifndef NGROUPS
  524. #define NGROUPS 32
  525. #endif
  526.     {
  527.         Groups_t gary[NGROUPS];
  528.  
  529.         i = getgroups(NGROUPS,gary);
  530.         while (--i >= 0) {
  531.         (void)sprintf(s," %ld", (long)gary[i]);
  532.         while (*s) s++;
  533.         }
  534.     }
  535. #endif
  536.     sv_setpv(sv,buf);
  537.     break;
  538.     case '*':
  539.     break;
  540.     case '0':
  541.     break;
  542.     }
  543.     return 0;
  544. }
  545.  
  546. int
  547. magic_getuvar(sv, mg)
  548. SV *sv;
  549. MAGIC *mg;
  550. {
  551.     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
  552.  
  553.     if (uf && uf->uf_val)
  554.     (*uf->uf_val)(uf->uf_index, sv);
  555.     return 0;
  556. }
  557.  
  558. int
  559. magic_setenv(sv,mg)
  560. SV* sv;
  561. MAGIC* mg;
  562. {
  563.     register char *s;
  564.     STRLEN len;
  565.     I32 i;
  566.     s = SvPV(sv,len);
  567.     my_setenv(mg->mg_ptr,s);
  568. #ifdef DYNAMIC_ENV_FETCH
  569.      /* We just undefd an environment var.  Is a replacement */
  570.      /* waiting in the wings? */
  571.     if (!len) {
  572.     SV **envsvp;
  573.     if (envsvp = hv_fetch(GvHVn(envgv),mg->mg_ptr,mg->mg_len,FALSE))
  574.         s = SvPV(*envsvp,len);
  575.     }
  576. #endif
  577.                 /* And you'll never guess what the dog had */
  578.                 /*   in its mouth... */
  579.     if (tainting) {
  580.     if (s && strEQ(mg->mg_ptr,"PATH")) {
  581.         char *strend = s + len;
  582.  
  583.         while (s < strend) {
  584.         s = cpytill(tokenbuf,s,strend,':',&i);
  585.         s++;
  586.         if (*tokenbuf != '/'
  587.           || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  588.             MgTAINTEDDIR_on(mg);
  589.         }
  590.     }
  591.     }
  592.     return 0;
  593. }
  594.  
  595. int
  596. magic_clearenv(sv,mg)
  597. SV* sv;
  598. MAGIC* mg;
  599. {
  600.     my_setenv(mg->mg_ptr,Nullch);
  601.     return 0;
  602. }
  603.  
  604. #ifdef HAS_SIGACTION
  605. /* set up reliable signal() clone */
  606.  
  607. typedef void (*Sigfunc) _((int));
  608.  
  609. static
  610. Sigfunc rsignal(signo,handler)
  611. int signo;
  612. Sigfunc handler;
  613. {
  614.     struct sigaction act,oact;
  615.     
  616.     act.sa_handler = handler;
  617.     sigemptyset(&act.sa_mask);
  618.     act.sa_flags = 0;
  619. #ifdef SIGALRM    
  620.     if (signo == SIGALRM) {
  621. #else
  622.     if (0) {
  623. #endif        
  624. #ifdef SA_INTERRUPT
  625.     act.sa_flags |= SA_INTERRUPT;    /* SunOS */
  626. #endif    
  627.     } else {
  628. #ifdef SA_RESTART
  629.     act.sa_flags |= SA_RESTART;    /* SVR4, 4.3+BSD */
  630. #endif
  631.     }
  632.     if (sigaction(signo, &act, &oact) < 0)
  633.         return(SIG_ERR);
  634.     else
  635.         return(oact.sa_handler);
  636. }
  637.  
  638. #else
  639.  
  640. /* ah well, so much for reliability */
  641.  
  642. #define rsignal(x,y) signal(x,y)
  643.  
  644. #endif
  645.  
  646.  
  647. int
  648. magic_setsig(sv,mg)
  649. SV* sv;
  650. MAGIC* mg;
  651. {
  652.     register char *s;
  653.     I32 i;
  654.     SV** svp;
  655.  
  656.     s = mg->mg_ptr;
  657.     if (*s == '_') {
  658.     if (strEQ(s,"__DIE__"))
  659.         svp = &diehook;
  660.     else if (strEQ(s,"__WARN__"))
  661.         svp = &warnhook;
  662.     else if (strEQ(s,"__PARSE__"))
  663.         svp = &parsehook;
  664.     else
  665.         croak("No such hook: %s", s);
  666.     i = 0;
  667.     if (*svp) {
  668.         SvREFCNT_dec(*svp);
  669.         *svp = 0;
  670.     }
  671.     }
  672.     else {
  673.     i = whichsig(s);    /* ...no, a brick */
  674.     if (!i) {
  675.         if (dowarn || strEQ(s,"ALARM"))
  676.         warn("No such signal: SIG%s", s);
  677.         return 0;
  678.     }
  679.     }
  680.     if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
  681.     if (i)
  682.         (void)rsignal(i,sighandler);
  683.     else
  684.         *svp = SvREFCNT_inc(sv);
  685.     return 0;
  686.     }
  687.     s = SvPV_force(sv,na);
  688.     if (strEQ(s,"IGNORE")) {
  689.     if (i)
  690.         (void)rsignal(i,SIG_IGN);
  691.     else
  692.         *svp = 0;
  693.     }
  694.     else if (strEQ(s,"DEFAULT") || !*s) {
  695.     if (i)
  696.         (void)rsignal(i,SIG_DFL);
  697.     else
  698.         *svp = 0;
  699.     }
  700.     else {
  701.     if (!strchr(s,':') && !strchr(s,'\'')) {
  702.         sprintf(tokenbuf, "main::%s",s);
  703.         sv_setpv(sv,tokenbuf);
  704.     }
  705.     if (i)
  706.         (void)rsignal(i,sighandler);
  707.     else
  708.         *svp = SvREFCNT_inc(sv);
  709.     }
  710.     return 0;
  711. }
  712.  
  713. int
  714. magic_setisa(sv,mg)
  715. SV* sv;
  716. MAGIC* mg;
  717. {
  718.     sub_generation++;
  719.     return 0;
  720. }
  721.  
  722. #ifdef OVERLOAD
  723.  
  724. int
  725. magic_setamagic(sv,mg)
  726. SV* sv;
  727. MAGIC* mg;
  728. {
  729.     /* HV_badAMAGIC_on(Sv_STASH(sv)); */
  730.     amagic_generation++;
  731.  
  732.     return 0;
  733. }
  734. #endif /* OVERLOAD */
  735.  
  736. static int
  737. magic_methpack(sv,mg,meth)
  738. SV* sv;
  739. MAGIC* mg;
  740. char *meth;
  741. {
  742.     dSP;
  743.  
  744.     ENTER;
  745.     SAVETMPS;
  746.     PUSHMARK(sp);
  747.     EXTEND(sp, 2);
  748.     PUSHs(mg->mg_obj);
  749.     if (mg->mg_ptr)
  750.     PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
  751.     else if (mg->mg_type == 'p')
  752.     PUSHs(sv_2mortal(newSViv(mg->mg_len)));
  753.     PUTBACK;
  754.  
  755.     if (perl_call_method(meth, G_SCALAR))
  756.     sv_setsv(sv, *stack_sp--);
  757.  
  758.     FREETMPS;
  759.     LEAVE;
  760.     return 0;
  761. }
  762.  
  763. int
  764. magic_getpack(sv,mg)
  765. SV* sv;
  766. MAGIC* mg;
  767. {
  768.     magic_methpack(sv,mg,"FETCH");
  769.     if (mg->mg_ptr)
  770.     mg->mg_flags |= MGf_GSKIP;
  771.     return 0;
  772. }
  773.  
  774. int
  775. magic_setpack(sv,mg)
  776. SV* sv;
  777. MAGIC* mg;
  778. {
  779.     dSP;
  780.  
  781.     PUSHMARK(sp);
  782.     EXTEND(sp, 3);
  783.     PUSHs(mg->mg_obj);
  784.     if (mg->mg_ptr)
  785.     PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
  786.     else if (mg->mg_type == 'p')
  787.     PUSHs(sv_2mortal(newSViv(mg->mg_len)));
  788.     PUSHs(sv);
  789.     PUTBACK;
  790.  
  791.     perl_call_method("STORE", G_SCALAR|G_DISCARD);
  792.  
  793.     return 0;
  794. }
  795.  
  796. int
  797. magic_clearpack(sv,mg)
  798. SV* sv;
  799. MAGIC* mg;
  800. {
  801.     return magic_methpack(sv,mg,"DELETE");
  802. }
  803.  
  804. int magic_wipepack(sv,mg)
  805. SV* sv;
  806. MAGIC* mg;
  807. {
  808.     dSP;
  809.  
  810.     PUSHMARK(sp);
  811.     XPUSHs(mg->mg_obj);
  812.     PUTBACK;
  813.  
  814.     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
  815.  
  816.     return 0;
  817. }
  818.  
  819. int
  820. magic_nextpack(sv,mg,key)
  821. SV* sv;
  822. MAGIC* mg;
  823. SV* key;
  824. {
  825.     dSP;
  826.     char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
  827.  
  828.     ENTER;
  829.     SAVETMPS;
  830.     PUSHMARK(sp);
  831.     EXTEND(sp, 2);
  832.     PUSHs(mg->mg_obj);
  833.     if (SvOK(key))
  834.     PUSHs(key);
  835.     PUTBACK;
  836.  
  837.     if (perl_call_method(meth, G_SCALAR))
  838.     sv_setsv(key, *stack_sp--);
  839.  
  840.     FREETMPS;
  841.     LEAVE;
  842.     return 0;
  843. }
  844.  
  845. int
  846. magic_existspack(sv,mg)
  847. SV* sv;
  848. MAGIC* mg;
  849. {
  850.     return magic_methpack(sv,mg,"EXISTS");
  851. } 
  852.  
  853. int
  854. magic_setdbline(sv,mg)
  855. SV* sv;
  856. MAGIC* mg;
  857. {
  858.     OP *o;
  859.     I32 i;
  860.     GV* gv;
  861.     SV** svp;
  862.  
  863.     gv = DBline;
  864.     i = SvTRUE(sv);
  865.     svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
  866.     if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
  867.     o->op_private = i;
  868.     else
  869.     warn("Can't break at that line\n");
  870.     return 0;
  871. }
  872.  
  873. int
  874. magic_getarylen(sv,mg)
  875. SV* sv;
  876. MAGIC* mg;
  877. {
  878.     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
  879.     return 0;
  880. }
  881.  
  882. int
  883. magic_setarylen(sv,mg)
  884. SV* sv;
  885. MAGIC* mg;
  886. {
  887.     av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
  888.     return 0;
  889. }
  890.  
  891. int
  892. magic_getpos(sv,mg)
  893. SV* sv;
  894. MAGIC* mg;
  895. {
  896.     SV* lsv = LvTARG(sv);
  897.     
  898.     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
  899.     mg = mg_find(lsv, 'g');
  900.     if (mg && mg->mg_len >= 0) {
  901.         sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
  902.         return 0;
  903.     }
  904.     }
  905.     (void)SvOK_off(sv);
  906.     return 0;
  907. }
  908.  
  909. int
  910. magic_setpos(sv,mg)
  911. SV* sv;
  912. MAGIC* mg;
  913. {
  914.     SV* lsv = LvTARG(sv);
  915.     SSize_t pos;
  916.     STRLEN len;
  917.  
  918.     mg = 0;
  919.     
  920.     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
  921.     mg = mg_find(lsv, 'g');
  922.     if (!mg) {
  923.     if (!SvOK(sv))
  924.         return 0;
  925.     sv_magic(lsv, (SV*)0, 'g', Nullch, 0);
  926.     mg = mg_find(lsv, 'g');
  927.     }
  928.     else if (!SvOK(sv)) {
  929.     mg->mg_len = -1;
  930.     return 0;
  931.     }
  932.     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
  933.  
  934.     pos = SvIV(sv) - curcop->cop_arybase;
  935.     if (pos < 0) {
  936.     pos += len;
  937.     if (pos < 0)
  938.         pos = 0;
  939.     }
  940.     else if (pos > len)
  941.     pos = len;
  942.     mg->mg_len = pos;
  943.  
  944.     return 0;
  945. }
  946.  
  947. int
  948. magic_getglob(sv,mg)
  949. SV* sv;
  950. MAGIC* mg;
  951. {
  952.     gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
  953.     return 0;
  954. }
  955.  
  956. int
  957. magic_setglob(sv,mg)
  958. SV* sv;
  959. MAGIC* mg;
  960. {
  961.     register char *s;
  962.     GV* gv;
  963.  
  964.     if (!SvOK(sv))
  965.     return 0;
  966.     s = SvPV(sv, na);
  967.     if (*s == '*' && s[1])
  968.     s++;
  969.     gv = gv_fetchpv(s,TRUE, SVt_PVGV);
  970.     if (sv == (SV*)gv)
  971.     return 0;
  972.     if (GvGP(sv))
  973.     gp_free(sv);
  974.     GvGP(sv) = gp_ref(GvGP(gv));
  975.     if (!GvAV(gv))
  976.     gv_AVadd(gv);
  977.     if (!GvHV(gv))
  978.     gv_HVadd(gv);
  979.     if (!GvIOp(gv))
  980.     GvIOp(gv) = newIO();
  981.     return 0;
  982. }
  983.  
  984. int
  985. magic_setsubstr(sv,mg)
  986. SV* sv;
  987. MAGIC* mg;
  988. {
  989.     STRLEN len;
  990.     char *tmps = SvPV(sv,len);
  991.     sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
  992.     return 0;
  993. }
  994.  
  995. int
  996. magic_gettaint(sv,mg)
  997. SV* sv;
  998. MAGIC* mg;
  999. {
  1000.     if (mg->mg_len & 1)
  1001.     tainted = TRUE;
  1002.     else if (mg->mg_len & 2 && mg->mg_obj == sv)    /* kludge */
  1003.     tainted = TRUE;
  1004.     return 0;
  1005. }
  1006.  
  1007. int
  1008. magic_settaint(sv,mg)
  1009. SV* sv;
  1010. MAGIC* mg;
  1011. {
  1012.     if (localizing) {
  1013.     if (localizing == 1)
  1014.         mg->mg_len <<= 1;
  1015.     else
  1016.         mg->mg_len >>= 1;
  1017.     }
  1018.     else if (tainted)
  1019.     mg->mg_len |= 1;
  1020.     else
  1021.     mg->mg_len &= ~1;
  1022.     return 0;
  1023. }
  1024.  
  1025. int
  1026. magic_setvec(sv,mg)
  1027. SV* sv;
  1028. MAGIC* mg;
  1029. {
  1030.     do_vecset(sv);    /* XXX slurp this routine */
  1031.     return 0;
  1032. }
  1033.  
  1034. int
  1035. magic_setmglob(sv,mg)
  1036. SV* sv;
  1037. MAGIC* mg;
  1038. {
  1039.     mg->mg_len = -1;
  1040.     SvSCREAM_off(sv);
  1041.     return 0;
  1042. }
  1043.  
  1044. int
  1045. magic_setbm(sv,mg)
  1046. SV* sv;
  1047. MAGIC* mg;
  1048. {
  1049.     sv_unmagic(sv, 'B');
  1050.     SvVALID_off(sv);
  1051.     return 0;
  1052. }
  1053.  
  1054. int
  1055. magic_setuvar(sv,mg)
  1056. SV* sv;
  1057. MAGIC* mg;
  1058. {
  1059.     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
  1060.  
  1061.     if (uf && uf->uf_set)
  1062.     (*uf->uf_set)(uf->uf_index, sv);
  1063.     return 0;
  1064. }
  1065.  
  1066. int
  1067. magic_set(sv,mg)
  1068. SV* sv;
  1069. MAGIC* mg;
  1070. {
  1071.     register char *s;
  1072.     I32 i;
  1073.     STRLEN len;
  1074.     switch (*mg->mg_ptr) {
  1075.     case '\001':    /* ^A */
  1076.     sv_setsv(bodytarget, sv);
  1077.     break;
  1078.     case '\004':    /* ^D */
  1079.     debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
  1080.     DEBUG_x(dump_all());
  1081.     break;
  1082.     case '\005':  /* ^E */
  1083. #ifdef macintosh
  1084.     gLastMacOSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1085. #else
  1086. #ifdef VMS
  1087.     set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1088. #else
  1089.     SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4);        /* will anyone ever use this? */
  1090. #endif
  1091. #endif
  1092.     break;
  1093.     case '\006':    /* ^F */
  1094.     maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1095.     break;
  1096.     case '\010':    /* ^H */
  1097.     hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1098.     break;
  1099.     case '\t':    /* ^I */
  1100.     if (inplace)
  1101.         Safefree(inplace);
  1102.     if (SvOK(sv))
  1103.         inplace = savepv(SvPV(sv,na));
  1104.     else
  1105.         inplace = Nullch;
  1106.     break;
  1107.     case '\017':    /* ^O */
  1108.     if (osname)
  1109.         Safefree(osname);
  1110.     if (SvOK(sv))
  1111.         osname = savepv(SvPV(sv,na));
  1112.     else
  1113.         osname = Nullch;
  1114.     break;
  1115.     case '\020':    /* ^P */
  1116.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1117.     if (i != perldb) {
  1118.         if (perldb)
  1119.         oldlastpm = curpm;
  1120.         else
  1121.         curpm = oldlastpm;
  1122.     }
  1123.     perldb = i;
  1124.     break;
  1125.     case '\024':    /* ^T */
  1126. #ifdef BIG_TIME
  1127.     basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
  1128. #else
  1129.     basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1130. #endif
  1131.     break;
  1132.     case '\027':    /* ^W */
  1133.     dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1134.     break;
  1135.     case '.':
  1136.     if (localizing) {
  1137.         if (localizing == 1)
  1138.         save_sptr((SV**)&last_in_gv);
  1139.     }
  1140.     else if (SvOK(sv))
  1141.         IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
  1142.     break;
  1143.     case '^':
  1144.     Safefree(IoTOP_NAME(GvIOp(defoutgv)));
  1145.     IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  1146.     IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  1147.     break;
  1148.     case '~':
  1149.     Safefree(IoFMT_NAME(GvIOp(defoutgv)));
  1150.     IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  1151.     IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  1152.     break;
  1153.     case '=':
  1154.     IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1155.     break;
  1156.     case '-':
  1157.     IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1158.     if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
  1159.         IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
  1160.     break;
  1161.     case '%':
  1162.     IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1163.     break;
  1164.     case '|':
  1165.     IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
  1166.     if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
  1167.         IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
  1168.     }
  1169.     break;
  1170.     case '*':
  1171.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1172.     multiline = (i != 0);
  1173.     break;
  1174.     case '/':
  1175.     SvREFCNT_dec(nrs);
  1176.     nrs = newSVsv(sv);
  1177.     SvREFCNT_dec(rs);
  1178.     rs = SvREFCNT_inc(nrs);
  1179.     break;
  1180.     case '\\':
  1181.     if (ors)
  1182.         Safefree(ors);
  1183.     ors = savepv(SvPV(sv,orslen));
  1184.     break;
  1185.     case ',':
  1186.     if (ofs)
  1187.         Safefree(ofs);
  1188.     ofs = savepv(SvPV(sv, ofslen));
  1189.     break;
  1190.     case '#':
  1191.     if (ofmt)
  1192.         Safefree(ofmt);
  1193.     ofmt = savepv(SvPV(sv,na));
  1194.     break;
  1195.     case '[':
  1196.     compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1197.     break;
  1198.     case '?':
  1199.     statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1200.     break;
  1201.     case '!':
  1202.     SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno);        /* will anyone ever use this? */
  1203.     break;
  1204.     case '<':
  1205.     uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1206.     if (delaymagic) {
  1207.         delaymagic |= DM_RUID;
  1208.         break;                /* don't do magic till later */
  1209.     }
  1210. #ifdef HAS_SETRUID
  1211.     (void)setruid((Uid_t)uid);
  1212. #else
  1213. #ifdef HAS_SETREUID
  1214.     (void)setreuid((Uid_t)uid, (Uid_t)-1);
  1215. #else
  1216. #ifdef HAS_SETRESUID
  1217.       (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
  1218. #else
  1219.     if (uid == euid)        /* special case $< = $> */
  1220.         (void)setuid(uid);
  1221.     else {
  1222.         uid = (I32)getuid();
  1223.         croak("setruid() not implemented");
  1224.     }
  1225. #endif
  1226. #endif
  1227. #endif
  1228.     uid = (I32)getuid();
  1229.     tainting |= (uid && (euid != uid || egid != gid));
  1230.     break;
  1231.     case '>':
  1232.     euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1233.     if (delaymagic) {
  1234.         delaymagic |= DM_EUID;
  1235.         break;                /* don't do magic till later */
  1236.     }
  1237. #ifdef HAS_SETEUID
  1238.     (void)seteuid((Uid_t)euid);
  1239. #else
  1240. #ifdef HAS_SETREUID
  1241.     (void)setreuid((Uid_t)-1, (Uid_t)euid);
  1242. #else
  1243. #ifdef HAS_SETRESUID
  1244.     (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
  1245. #else
  1246.     if (euid == uid)        /* special case $> = $< */
  1247.         setuid(euid);
  1248.     else {
  1249.         euid = (I32)geteuid();
  1250.         croak("seteuid() not implemented");
  1251.     }
  1252. #endif
  1253. #endif
  1254. #endif
  1255.     euid = (I32)geteuid();
  1256.     tainting |= (uid && (euid != uid || egid != gid));
  1257.     break;
  1258.     case '(':
  1259.     gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1260.     if (delaymagic) {
  1261.         delaymagic |= DM_RGID;
  1262.         break;                /* don't do magic till later */
  1263.     }
  1264. #ifdef HAS_SETRGID
  1265.     (void)setrgid((Gid_t)gid);
  1266. #else
  1267. #ifdef HAS_SETREGID
  1268.     (void)setregid((Gid_t)gid, (Gid_t)-1);
  1269. #else
  1270. #ifdef HAS_SETRESGID
  1271.       (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
  1272. #else
  1273.     if (gid == egid)            /* special case $( = $) */
  1274.         (void)setgid(gid);
  1275.     else {
  1276.         gid = (I32)getgid();
  1277.         croak("setrgid() not implemented");
  1278.     }
  1279. #endif
  1280. #endif
  1281. #endif
  1282.     gid = (I32)getgid();
  1283.     tainting |= (uid && (euid != uid || egid != gid));
  1284.     break;
  1285.     case ')':
  1286.     egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1287.     if (delaymagic) {
  1288.         delaymagic |= DM_EGID;
  1289.         break;                /* don't do magic till later */
  1290.     }
  1291. #ifdef HAS_SETEGID
  1292.     (void)setegid((Gid_t)egid);
  1293. #else
  1294. #ifdef HAS_SETREGID
  1295.     (void)setregid((Gid_t)-1, (Gid_t)egid);
  1296. #else
  1297. #ifdef HAS_SETRESGID
  1298.     (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
  1299. #else
  1300.     if (egid == gid)            /* special case $) = $( */
  1301.         (void)setgid(egid);
  1302.     else {
  1303.         egid = (I32)getegid();
  1304.         croak("setegid() not implemented");
  1305.     }
  1306. #endif
  1307. #endif
  1308. #endif
  1309.     egid = (I32)getegid();
  1310.     tainting |= (uid && (euid != uid || egid != gid));
  1311.     break;
  1312.     case ':':
  1313.     chopset = SvPV_force(sv,na);
  1314.     break;
  1315.     case '0':
  1316.     if (!origalen) {
  1317.         s = origargv[0];
  1318.         s += strlen(s);
  1319.         /* See if all the arguments are contiguous in memory */
  1320.         for (i = 1; i < origargc; i++) {
  1321.         if (origargv[i] == s + 1)
  1322.             s += strlen(++s);    /* this one is ok too */
  1323.         }
  1324.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  1325.         my_setenv("NoNeSuCh", Nullch);
  1326.                         /* force copy of environment */
  1327.         for (i = 0; origenviron[i]; i++)
  1328.             if (origenviron[i] == s + 1)
  1329.             s += strlen(++s);
  1330.         }
  1331.         origalen = s - origargv[0];
  1332.     }
  1333.     s = SvPV_force(sv,len);
  1334.     i = len;
  1335.     if (i >= origalen) {
  1336.         i = origalen;
  1337.         SvCUR_set(sv, i);
  1338.         *SvEND(sv) = '\0';
  1339.         Copy(s, origargv[0], i, char);
  1340.     }
  1341.     else {
  1342.         Copy(s, origargv[0], i, char);
  1343.         s = origargv[0]+i;
  1344.         *s++ = '\0';
  1345.         while (++i < origalen)
  1346.         *s++ = ' ';
  1347.         s = origargv[0]+i;
  1348.         for (i = 1; i < origargc; i++)
  1349.         origargv[i] = Nullch;
  1350.     }
  1351.     break;
  1352.     }
  1353.     return 0;
  1354. }
  1355.  
  1356. I32
  1357. whichsig(sig)
  1358. char *sig;
  1359. {
  1360.     register char **sigv;
  1361.  
  1362.     for (sigv = sig_name+1; *sigv; sigv++)
  1363.     if (strEQ(sig,*sigv))
  1364.         return sig_num[sigv - sig_name];
  1365. #ifdef SIGCLD
  1366.     if (strEQ(sig,"CHLD"))
  1367.     return SIGCLD;
  1368. #endif
  1369. #ifdef SIGCHLD
  1370.     if (strEQ(sig,"CLD"))
  1371.     return SIGCHLD;
  1372. #endif
  1373.     return 0;
  1374. }
  1375.  
  1376. Signal_t
  1377. sighandler(sig)
  1378. int sig;
  1379. {
  1380.     dSP;
  1381.     GV *gv;
  1382.     HV *st;
  1383.     SV *sv;
  1384.     CV *cv;
  1385.     AV *oldstack;
  1386.     char *signame; 
  1387.  
  1388. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  1389.     signal(sig, SIG_ACK);
  1390. #endif
  1391.  
  1392.     signame = sig_name[sig];
  1393.     cv = sv_2cv(*hv_fetch(GvHVn(siggv),signame,strlen(signame),
  1394.               TRUE),
  1395.         &st, &gv, TRUE);
  1396.     if (!cv || !CvROOT(cv) &&
  1397.     *signame == 'C' && instr(signame,"LD")) {
  1398.     
  1399.     if (signame[1] == 'H')
  1400.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE),
  1401.             &st, &gv, TRUE);
  1402.     else
  1403.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE),
  1404.             &st, &gv, TRUE);
  1405.     /* gag */
  1406.     }
  1407.     if (!cv || !CvROOT(cv)) {
  1408.     if (dowarn)
  1409.         warn("SIG%s handler \"%s\" not defined.\n",
  1410.         signame, GvENAME(gv) );
  1411.     return;
  1412.     }
  1413.  
  1414.     oldstack = stack;
  1415.     if (stack != signalstack)
  1416.     AvFILL(signalstack) = 0;
  1417.     SWITCHSTACK(stack, signalstack);
  1418.  
  1419.     sv = sv_newmortal();
  1420.     sv_setpv(sv,signame);
  1421.     PUSHMARK(sp);
  1422.     PUSHs(sv);
  1423.     PUTBACK;
  1424.  
  1425.     perl_call_sv((SV*)cv, G_DISCARD);
  1426.  
  1427.     SWITCHSTACK(signalstack, oldstack);
  1428.  
  1429.     return;
  1430. }
  1431.